home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.07.lha / AmiCAD / ARexx / SelectNet.AmiCAD < prev    next >
Text File  |  2000-12-06  |  7KB  |  283 lines
  1. /* Sélection d'une netlist */
  2. /* Version 1.00 (14-07-98) */
  3. /* Version 1.01 (13/01/99)  Modif test clic liaison */
  4. /* Version 1.02 (6/9/99)    Ajout UNLOCK */
  5. /* Version 1.03 (14/04/00)  Adaptation version 2.05 */
  6. /* Version 1.04 (11/11/00)  Localisation anglais/français */
  7. /* Version 1.05 (06/12/00)  Ajout traitement masses et alimentations multiples */
  8. /* $VER: SelectNat.AmiCAD 1.05 (© R.Florac, 06/12/2000) */
  9. /* Ne recherche pas les labels multiples */
  10. /* Ne teste que les lignes horizontales ou verticales */
  11.  
  12. options results     /* indispensable pour récupérer le résultat des macros */
  13.  
  14. signal on error     /* pour l'interception des erreurs */
  15. signal on syntax
  16.  
  17. 'LANGUAGE'
  18. if result="français.language" then fr=1
  19. else fr=0
  20.  
  21. 'FIRSTSEL'; i=result
  22. if result~=0 then do
  23.     'NEXTSEL(FIRSTSEL)'
  24.     if result~=0 then i=0
  25. end
  26.  
  27. if i=0 then do
  28.     if fr=1 then 'PICKOBJ("Cliquez sur la liaison à tester")'
  29.     else 'PICKOBJ("Click on a net")'
  30.     i=result
  31. end
  32.  
  33. if i<=0 then exit
  34. 'OBJECTS'
  35. objets=result
  36. 'LOCK:TYPE(O='i')'
  37. if result=2 then 'UNMARK(-1)'
  38. else do
  39.     if fr=1 then 'MESSAGE("Sélection incorrecte"):UNLOCK'
  40.     else 'MESSAGE("Bad selection"):UNLOCK'
  41.     exit
  42. end
  43.  
  44. label=test_liaison(i)
  45. if label='0' then do
  46.     if fr=1 then 'TITLE("Recherche autres masses...")'
  47.     else 'TITLE("Looking for other grounds...")'
  48.     do i=1 to objets
  49.     'FINDPART('i',"MASSE")'
  50.     j=result
  51.     if j=0 then do
  52.         'FINDPART('i',"MASSE2")'
  53.         j=result
  54.     end
  55.     if j>0 then do
  56.         'TEST('j')'
  57.         if result=0 then do
  58.         k=connexion_broche(j,1)
  59.         if k>0 then do
  60.             'MARK('j')'
  61.             call test_liaison(k)
  62.         end
  63.         end
  64.     end
  65.     else leave i
  66.     i=j
  67.     end
  68. end
  69. else if label~="" then do
  70.     if fr=1 then 'TITLE("Recherche autres alimentations...")'
  71.     else 'TITLE("Looking for other powers...")'
  72.     do i=1 to objets
  73.     'FINDPART('i',"ALIMENTATION")'
  74.     j=result
  75.     if j>0 then do
  76.         'TEST('j')'
  77.         if result=0 then do
  78.         '_V_=GETVAL('j')'
  79.         if result=0 then '_V_=GETREF('j')'
  80.         if result>0 then do
  81.             'READTEXT(_V_)'
  82.             if result=label then do
  83.             k=connexion_broche(j,1)
  84.             if k>0 then do
  85.                 'MARK('j',_V_)'
  86.                 call test_liaison(k)
  87.             end
  88.             end
  89.         end
  90.         end
  91.     end
  92.     else leave i
  93.     i=j
  94.     end
  95. end
  96. 'TITLE("")'
  97. if label="" then do
  98.     if fr=1 then label="non nommée"
  99.     else label="unnamed"
  100. end
  101. if fr=1 then 'MESSAGE("Équipotentielle 'label'")'
  102. else 'MESSAGE("Net 'label'")'
  103. 'UNLOCK'
  104. exit
  105.  
  106. /* Procédure principale (recherche des liaisons appartenant à un réseau) */
  107. test_liaison: procedure expose net. fr
  108.     parse arg i
  109.     /* Test des liaisons */
  110.     j=1; nets=0; net.0=""
  111.     if fr=1 then 'TITLE("Lecture des liaisons en cours..."):OBJECTS'
  112.     else 'TITLE("Reading nets..."):OBJECTS'
  113.     objets=result
  114.  
  115.     /* Initialisation de l'appartenance des objets à une équipotentielle */
  116.     net.=-1
  117.  
  118.     'COORDS(O='i')'         /* Marquage du fil */
  119.     parse var result x0','y0','x1','y1
  120.     call test_ligne(x0,y0,objets)
  121.     call test_ligne(x1,y1,objets)
  122.  
  123.     if fr=1 then 'TITLE("Test des jonctions...")'
  124.     else 'TITLE("Checking junctions...")'
  125.     m=1
  126.     do while m>0
  127.     m=0
  128.     i=1
  129.     do while i>0
  130.         'OO=FINDOBJ('i',7,-1,-1)'; i=result
  131.         if i>0 then do
  132.         'TEST(OO)'
  133.         if result=0 then do
  134.             'COL(OO)'; x0=result
  135.             'LINE(OO)'; y0=result
  136.             n=test_jonction(x0,y0,objets)
  137.             if n=1 then do    /* la jonction appartient au net */
  138.                'MARK(OO)'
  139.             call marquer_ligne(x0,y0,objets)
  140.             m=1
  141.             end
  142.         end
  143.         if i=objets then i=0
  144.         else i=i+1
  145.         end
  146.     end
  147.     end
  148.  
  149.     if fr=1 then 'TITLE("Recherche des masses...")'
  150.     else 'TITLE("Searching grounds...")'
  151.     label=""
  152.     do i=1 to objets
  153.     'O=FINDPART('i',"MASSE")'; i=result
  154.     if i>0 then do
  155.         j=connexion_broche(i,1)
  156.         if j>0 then do
  157.         'TEST('j')'
  158.         if result=1 then do
  159.             'MARK('i')'
  160.             label=0
  161.             leave i
  162.         end
  163.         end
  164.         i=i+1
  165.     end
  166.     else leave
  167.     end
  168.  
  169.     if label="" then do
  170.     if fr=1 then 'TITLE("Recherche des labels...")'
  171.     else 'TITLE("Searching labels...")'
  172.     do i=1 to objets
  173.         'TYPE(O='i')'
  174.         if result=4 | result=12 | result=11 then do
  175.         'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
  176.         if j>0 then do
  177.             'TEST('j')'
  178.             if result=1 then do
  179.             'READTEXT(O)'; label=result; leave i
  180.             end
  181.         end
  182.         end
  183.     end
  184.     end
  185.  
  186.     if label="" then do
  187.     if fr=1 then 'TITLE("Recherche des alimentations...")'
  188.     else 'TITLE("Searching powers...")'
  189.     do i=1 to objets
  190.         'O=FINDPART('i',"ALIMENTATION")'; i=result
  191.         if i>0 then do
  192.         j=connexion_broche(i,1)
  193.         if j>0 then do
  194.             'TEST('j')'
  195.             if result=1 then do
  196.             '_V_=GETVAL(O)'
  197.             if result=0 then '_V_=GETREF(O)'
  198.             if result~=0 then  do
  199.                 'MARK(O):MARK(_V_):READTEXT(_V_)'; label=result; leave i
  200.             end
  201.             end
  202.         end
  203.         i=i+1
  204.         end
  205.         else leave
  206.     end
  207.     end
  208.     return label
  209.  
  210. test_ligne: procedure expose net.
  211.     parse arg x0,y0,objets
  212.     o=1
  213.     do until o=0
  214.     'X=FINDOBJ('o',2,'x0','y0')'; o=result
  215.     if o>0 then do
  216.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  217.         if result~=0 then do
  218.         net.o=1
  219.         parse var result x1','y1','x2','y2
  220.         if x0=x1 & y0=y1 then call test_ligne(x2,y2,objets)
  221.         else call test_ligne(x1,y1,objets)
  222.         end
  223.         if o=objets then return
  224.         o=o+1
  225.     end
  226.     end
  227.     return
  228.  
  229. marquer_ligne: procedure expose net.
  230.     parse arg x0,y0,objets
  231.     o=1
  232.     do until o=0
  233.     'X=ABS(FINDLINE('o','x0','y0'))'; o=result
  234.     if o>0 then do
  235.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  236.         if result~=0 then do
  237.         net.o=1
  238.         parse var result xl','yl','x1','y1
  239.         call test_ligne(xl,yl,objets)
  240.         call test_ligne(x1,y1,objets)
  241.         end
  242.         if o=objets then return
  243.         o=o+1
  244.     end
  245.     end
  246.     return
  247.  
  248. test_jonction: procedure expose net.
  249.     parse arg xj,yj,objets
  250.     obj=1
  251.     do while obj>0
  252.     'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
  253.     if net.obj=1 then return 1
  254.     if obj=0 then return 0
  255.     if obj=objets then return 0
  256.     obj=obj+1
  257.     end
  258.     return 0
  259.  
  260. connexion_broche: procedure
  261.     parse arg objet,broche
  262.     'PINCOL(O='objet',B='broche')'; xj=result
  263.     'PINLINE(O,B)'; yj=result
  264.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  265.     if xl>0 then return xl
  266.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  267.     if xl<=0 then return 0
  268.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  269.     if result>0 then return xl
  270.     return 0
  271.  
  272. /* Traitement des erreurs, interruption du programme */
  273. syntax:
  274. erreur=RC
  275. if fr=1 then 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
  276. else 'MESSAGE("Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
  277. exit
  278.  
  279. error:
  280. if fr=1 then 'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK'
  281. else 'MESSAGE("Error in line 'SIGL'"):UNLOCK'
  282. exit
  283.